Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/mymem1/mymemory.frm

Visual Basic Form | 1995-05-08 | 17.1 KB | 484 lines

VERSION 2.00
Begin Form MyMemory
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Your Memory Is What?"
   ClientHeight    =   1575
   ClientLeft      =   1095
   ClientTop       =   1740
   ClientWidth     =   4155
   Height          =   2265
   Icon            =   MYMEMORY.FRX:0000
   Left            =   1035
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   105
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   277
   Tag             =   "MyMemory"
   Top             =   1110
   Width           =   4275
   Begin Label LabelSquareStatus
      Alignment       =   2  'Center
      BackColor       =   &H0000FFFF&
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   12
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      ForeColor       =   &H000000FF&
      Height          =   375
      Left            =   120
      TabIndex        =   0
      Top             =   1080
      Width           =   3615
   End
   Begin Label LabelFieldStatus
      Alignment       =   2  'Center
      BackColor       =   &H00FFFF00&
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   12
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   375
      Left            =   120
      TabIndex        =   1
      Top             =   600
      Width           =   3615
   End
   Begin Label FieldDesc
      Alignment       =   2  'Center
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   12
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   375
      Left            =   120
      TabIndex        =   2
      Top             =   120
      Width           =   3615
   End
   Begin Menu MenuGame
      Caption         =   "&Game"
      Begin Menu MenuNew
         Caption         =   "&New Game"
         Shortcut        =   {F2}
      End
      Begin Menu MenuSettings
         Caption         =   "&Settings"
         Shortcut        =   {F3}
      End
      Begin Menu MenuShowRecord
         Caption         =   "Show &Record"
         Shortcut        =   {F4}
      End
      Begin Menu MenuSepBar
         Caption         =   "-"
      End
      Begin Menu MenuExit
         Caption         =   "E&xit"
         Shortcut        =   ^X
      End
   End
   Begin Menu MenuHelp
      Caption         =   "&Help"
   End
'From example in VB Language Reference manual page 141
Declare Sub FloodFill Lib "GDI" (ByVal hDC As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal Color As Long)
'Needed to get physical size of screen (from WINAPI.TXT)
Const HORZRES = 8
Const VERTRES = 10
Declare Function GetDeviceCaps Lib "GDI" (ByVal hDC As Integer, ByVal nIndex As Integer) As Integer
Sub Form_Load ()
    NL = Chr$(13) + Chr$(10)
'initialize user settings, in case no profile
    NumberXSquares = DefaultXSquares
    NumberYSquares = DefaultYSquares
    SquareSize = DefaultSquareSize
    SetTimer = DefaultTimer
    SaveFile = SelectSaveFileNo
    SaveScore = UNCHECKED
    For I% = 0 To 5
        For J% = 0 To 2
            ScoreArray(I%, J%) = NoScore
        Next J%
    Next I%
    ScreenPixelSizeX = GetDeviceCaps(hDC, HORZRES)
    ScreenPixelSizeY = GetDeviceCaps(hDC, VERTRES)
'Indicate no change to Game Setup since beginning or after reading profile
    SaveFileChange = False
'See if there is a game setup (profile) in an INI file
    MyProfile
'Change array size to match number of squares, especially if MyProfile changed size
    ReDim SquareStatusArray(NumberXSquares, NumberYSquares)
    ReDim SquareSceneArray(NumberXSquares, NumberYSquares)
'indicate game not started
    FieldStatus = FieldNotReady
'set form size - Form set smaller during development because
'it was easier to work with
    Top = 0
    Left = 0
    ResizeMyMemoryForm
    Show
End Sub
Sub Form_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
'Get X and Y offsets for scene and status variable arrays
    Xs% = X \ SquareSize
    Ys% = Y \ SquareSize
'Get X and Y pixel offsets for square
    Xp% = Xs% * SquareSize
    Yp% = Ys% * SquareSize
'Process left button click, ignore right or middle button
    If Button = LEFT_BUTTON Then

        'is game in progress
        If FieldStatus = FieldReady Then

            'process square only if closed, ignore if open with scene
            If SquareStatusArray(Xs%, Ys%) = FieldClosed Then
                Scene% = SquareSceneArray(Xs%, Ys%)

                'open square and show scene, but don't allow a third to show
                'before processing first two (if you click ahead 3 times)
                If CurrentSquare < 2 Then ShowSquare Xp%, Yp%, Scene%

                If CurrentSquare = 0 Then
                    'get first square of pair
                    CurrentSquare = 1
                    CurrentSquare1 = Scene%
                    CurrentSquare1X = Xs%
                    CurrentSquare1Y = Ys%
                    SquareStatusArray(Xs%, Ys%) = SquareOpen

                ElseIf CurrentSquare = 1 Then
                    CurrentSquare = 2

                    'get second square of pair and see if they match
                    If CurrentSquare1 <> Scene% Then
                        LabelSquareStatus.Caption = "Squares do not Match!"
                        'give VB time to display caption
                        Temp% = DoEvents()
                        MyTimer SetTimer
                        BuildSquare Xp%, Yp%
                        Xp% = CurrentSquare1X * SquareSize
                        Yp% = CurrentSquare1Y * SquareSize
                        BuildSquare Xp%, Yp%
                        SquareStatusArray(CurrentSquare1X, CurrentSquare1Y) = SquareClosed
                        LabelSquareStatus.Caption = ""
                    Else
                        LabelSquareStatus.Caption = "Squares Match!"
                        SquareStatusArray(Xs%, Ys%) = SquareSolved
                        SquareStatusArray(CurrentSquare1X, CurrentSquare1Y) = SquareSolved
                        CurrentSolved = CurrentSolved + 2
                    End If

                    'after showing second square, reset and update
                    CurrentSquare = 0
                    CurrentMoves = CurrentMoves + 1

                    LabelFieldStatus.Caption = "You have made" + Str$(CurrentMoves) + MoveWord
                    If CurrentMoves = 1 Then MoveWord = " moves."

                    'see if user solved available number of pairs
                    If CurrentSolved = NumberXSquares * NumberYSquares Then
                        SaveMyScore
                        FieldStatus = FieldSolved
                        LabelSquareStatus.Caption = "Game Solved"
                    End If
                End If
            End If
        Else
            'Field not ready or solved, go build field
            InitField
        End If
    End If
End Sub
Sub Form_Paint ()
'Build existing game, SquareOpen should not be a problem
'because its status will soon change
    If FieldStatus <> FieldNotReady Then
        For X% = 0 To (NumberXSquares - 1)
            For Y% = 0 To (NumberYSquares - 1)
                Xp% = X% * SquareSize
                Yp% = Y% * SquareSize
                If SquareStatusArray(X%, Y%) = SquareClosed Then
                    BuildSquare Xp%, Yp%
                ElseIf SquareStatusArray(X%, Y%) = SquareSolved Then
                    Scene% = SquareSceneArray(X%, Y%)
                    ShowSquare Xp%, Yp%, Scene%
                End If
            Next Y%
        Next X%
    End If
End Sub
Sub Form_Unload (Cancel As Integer)
    SaveMyProfile
    End
End Sub
Sub MenuExit_Click ()
    Msg$ = "Do you really want to quit?"
    Response% = MsgBox(Msg$, MB_YESNO, "Quit")
    If Response% = IDYES Then
        SaveMyProfile
        End
    End If
End Sub
Sub MenuHelp_Click ()
    MyHelp.Show 1
End Sub
Sub MenuNew_Click ()
'If game started, see if user really wants to quit
    If FieldStatus = FieldReady Then
        Msg$ = "You haven't finished playing the current game!" + NL
        Msg$ = Msg$ + "Do you really want to start a new game?"
        Response% = MsgBox(Msg$, MB_YESNO, "New Game")
        If Response% <> IDYES Then Exit Sub
    End If
'Status not ready, solved or user wanted new game
    InitField
End Sub
Sub MenuSettings_Click ()
'Tell player to wait
    MousePointer = HOURGLASS
'load in the dialog box but don't show
    Load MySet
'Reflect current number of squares in the X direction
    Select Case NumberXSquares
        Case 8
            MySet.OptionH8.Value = True
        Case 10
            MySet.OptionH10.Value = True
        Case 12
            MySet.OptionH12.Value = True
        Case 14
            MySet.OptionH14.Value = True
        Case 16
            MySet.OptionH16.Value = True
        Case 18
            MySet.OptionH18.Value = True
    End Select
'Reflect current number of squares in the Y direction
    Select Case NumberYSquares
        Case 6
            MySet.OptionV6.Value = True
        Case 8
            MySet.OptionV8.Value = True
        Case 10
            MySet.OptionV10.Value = True
    End Select
'Reflect current size of squares
    Select Case SquareSize
        Case 32
            MySet.OptionP32.Value = True
        Case 40
            MySet.OptionP40.Value = True
        Case 48
            MySet.OptionP48.Value = True
    End Select
'Reflect current timer value
    Select Case SetTimer
        Case 1!
            MySet.OptionS1.Value = True
        Case 2!
            MySet.OptionS2.Value = True
        Case 3!
            MySet.OptionS3.Value = True
        Case 4!
            MySet.OptionS4.Value = True
        Case 5!
            MySet.OptionS5.Value = True
    End Select
'Reflect current settings file if any
    Select Case SaveFile
        Case SelectSaveFileNo
            MySet.OptionSaveNo.Value = True
            MySet.CheckScore.Enabled = False
        Case SelectSaveFileWIN
            MySet.OptionSaveWIN.Value = True
            MySet.CheckScore.Enabled = True
        Case SelectSaveFileWEP
            MySet.OptionSaveWEP.Value = True
            MySet.CheckScore.Enabled = True
        Case SelectSaveFileMy
            MySet.OptionSaveMy.Value = True
            MySet.CheckScore.Enabled = True
    End Select
    MySet.CheckScore.Value = SaveScore
'Disable invalid X, Y and Square sizes
    If 18 * SquareSize > ScreenPixelSizeX Then MySet.OptionH18.Enabled = False
    If 16 * SquareSize > ScreenPixelSizeX Then MySet.OptionH16.Enabled = False
    If 14 * SquareSize > ScreenPixelSizeX Then MySet.OptionH14.Enabled = False
    FieldY% = MyMemory.LabelFieldStatus.Height + MyMemory.FieldDesc.Height + (FormHeader / TwipsPerPixel)
    If 10 * SquareSize + FieldY% > ScreenPixelSizeY Then MySet.OptionV10.Enabled = False
    If 8 * SquareSize + FieldY% > ScreenPixelSizeY Then MySet.OptionV8.Enabled = False
'Tell player we're thru
    MousePointer = DEFAULT
'now show the form
    MySet.Show MODAL
End Sub
Sub MenuShowRecord_Click ()
    MyGp.Show
    For I% = 0 To 5
        For J% = 0 To 2
            MyGp.PGame.Print Str$((I% * 2) + 8) + " x" + Str$((J% * 2) + 6)
            If ScoreArray(I%, J%) = NoScore Then
                MyGp.PScore.Print
                MyGp.PName.Print
            Else
                MyGp.PScore.Print Str$(ScoreArray(I%, J%))
                MyGp.PName.Print " " + ScoreArrayName(I%, J%)
            End If
        Next J%
    Next I%
End Sub
Sub MyTimer (Timerval As Single)
'wait seconds asked for by caller
    Start! = Timer
    Finish! = Start! + Timerval
    Do While current! < Finish!
        current! = Timer
    Loop
End Sub
Sub ShowSquare (X As Integer, Y As Integer, Scene As Integer)
'clear the square first
    Line (X, Y)-(X + SquareSize - 1, Y + SquareSize - 1), GRAY_LIGHT, B
    Line (X + 1, Y + 1)-(X + SquareSize - 2, Y + SquareSize - 2), GRAY_LIGHT, B
'set offset to center
    Xc% = X + (SquareSize / 2)
    Yc% = Y + (SquareSize / 2)
'set size of object, size% is offset from center
    Size% = SquareSize / 4
'Select Color
    Select Case Scene

        Case 0, 8, 16, 24, 32, 40, 48, 56, 64, 72, 80, 88
            Color& = BLACK
            Color2& = WHITE

        Case 1, 9, 17, 25, 33, 41, 49, 57, 65, 73, 81, 89
            Color& = RED
            Color2& = YELLOW

        Case 2, 10, 18, 26, 34, 42, 50, 58, 66, 74, 82, 90
            Color& = GREEN
            Color2& = BLUE

        Case 3, 11, 19, 27, 35, 43, 51, 59, 67, 75, 83, 91
            Color& = BLUE
            Color2& = GREEN

        Case 4, 12, 20, 28, 36, 44, 52, 60, 68, 76, 84, 92
            Color& = YELLOW
            Color2& = RED

        Case 5, 13, 21, 29, 37, 45, 53, 61, 69, 77, 85, 93
            Color& = MAGENTA
            Color2& = CYAN

        Case 6, 14, 22, 30, 38, 46, 54, 62, 70, 78, 86, 94
            Color& = CYAN
            Color2& = MAGENTA

        Case 7, 15, 23, 31, 39, 47, 55, 63, 71, 79, 87, 95
            Color& = WHITE
            Color2& = BLACK
    End Select
'now show scene
    Select Case Scene

        Case 0 To 7
            'draw square, no fill color
            Line (Xc% - Size%, Yc% - Size%)-(Xc% + Size%, Yc% + Size%), Color&, B

        Case 8 To 15
            'draw square, filled
            Line (Xc% - Size%, Yc% - Size%)-(Xc% + Size%, Yc% + Size%), Color&, BF

        Case 16 To 23
            'draw circle, no fill color
            Circle (Xc%, Yc%), Size%, Color&

        Case 24 To 31
            'draw circle, filled
            FillColor = Color&
            FillStyle = SOLID
            Circle (Xc%, Yc%), Size%, Color&
            FillStyle = TRANSPARENT

        Case 32 To 39
            'draw triangle, no fill color
            Line (Xc%, Yc% - Size%)-(Xc% + Size%, Yc% + Size%), Color&
            Line -(Xc% - Size%, Yc% + Size%), Color&
            Line -(Xc%, Yc% - Size%), Color&

        Case 40 To 47
            'draw triangle, filled
            Line (Xc%, Yc% - Size%)-(Xc% + Size%, Yc% + Size%), Color&
            Line -(Xc% - Size%, Yc% + Size%), Color&
            Line -(Xc%, Yc% - Size%), Color&
            FillColor = Color&
            FillStyle = SOLID
            FloodFill hDC, Xc%, Yc%, Color&
            FillStyle = TRANSPARENT

        Case 48 To 55
            'draw upside down triangle, no fill color
            Line (Xc%, Yc% + Size%)-(Xc% + Size%, Yc% - Size%), Color&
            Line -(Xc% - Size%, Yc% - Size%), Color&
            Line -(Xc%, Yc% + Size%), Color&

        Case 56 To 63
            'draw upside down triangle, filled
            Line (Xc%, Yc% + Size%)-(Xc% + Size%, Yc% - Size%), Color&
            Line -(Xc% - Size%, Yc% - Size%), Color&
            Line -(Xc%, Yc% + Size%), Color&
            FillColor = Color&
            FillStyle = SOLID
            FloodFill hDC, Xc%, Yc%, Color&
            FillStyle = TRANSPARENT

        Case 64 To 71
            'draw diamond, no fill color
            Line (Xc%, Yc% - Size%)-(Xc% + Size%, Yc%), Color&
            Line -(Xc%, Yc% + Size%), Color&
            Line -(Xc% - Size%, Yc%), Color&
            Line -(Xc%, Yc% - Size%), Color&

        Case 72 To 79
            'draw diamond, filled
            Line (Xc%, Yc% - Size%)-(Xc% + Size%, Yc%), Color&
            Line -(Xc%, Yc% + Size%), Color&
            Line -(Xc% - Size%, Yc%), Color&
            Line -(Xc%, Yc% - Size%), Color&
            FillColor = Color&
            FillStyle = SOLID
            FloodFill hDC, Xc%, Yc%, Color&
            FillStyle = TRANSPARENT

        Case 80 To 87
            'draw double square, filled
            Line (Xc% - Size%, Yc% - Size%)-(Xc% + Size%, Yc% + Size%), Color&, BF
            Line (Xc% - Size% / 2, Yc% - Size% / 2)-(Xc% + Size% / 2, Yc% + Size% / 2), Color2&, BF

        Case 88 To 95
            'draw double circle, filled
            FillColor = Color&
            FillStyle = SOLID
            Circle (Xc%, Yc%), Size%, Color&
            FillColor = Color2&
            Circle (Xc%, Yc%), Size% / 2, Color2&
            FillStyle = TRANSPARENT
        Case Else
            'In case I missed one
            CurrentX = Xc%
            CurrentY = Yc%
            Print Str$(Scene)
    End Select
End Sub